﻿namespace CmdArgs

open System
open Printf

[<RequireQualifiedAccess>]
type ArgType =
  | String of (string -> unit)
  | Float of (float -> unit)
  | Int of (int -> unit)
  | Unit of (unit -> unit)
  | TimeSpan of (TimeSpan -> unit)
  | DateTime of (DateTime -> unit)

type ArgInfo(name, typ, help) =
  member this.Name : string = name
  member this.Type = typ
  member this.Help = help

type ArgParser private (argSpec:array<ArgInfo>, rest:(string -> unit) option) =
  do
    match argSpec with null -> nullArg "argSpec" | _ -> ()

  let exeName = AppDomain.CurrentDomain.FriendlyName

  [<Literal>]
  let screenWidth = 80

  let getSnippet start length text =
    let n = String.length text
    if start >= n then None, None
    elif (n - start) <= length then Some (text.Substring(start)), None
    else
      let rec loop i =
        if i = start then Some (text.Substring(start, length)), Some (start + length)
        else
          match text.[i] with
          | ' ' -> Some (text.Substring(start, i - start)), Some (i + 1)
          | '-' -> Some (text.Substring(start, i - start + 1)), Some (i + 1)
          | _ -> loop (i - 1)
      loop (start + length - 1)

  let typeName = function
    | ArgType.String _ -> "string"
    | ArgType.Float _ -> "float"
    | ArgType.Int _ -> "integer"
    | ArgType.TimeSpan _ -> "duration"
    | ArgType.DateTime _ -> "date"
    | ArgType.Unit _ -> ""

  new (argSpec, rest) = ArgParser(argSpec, Some rest)
  new (argSpec) = ArgParser(argSpec, None)

  member this.Usage() =
    let usage = System.Text.StringBuilder()
    bprintf usage "\nUsage: %s" exeName
    match argSpec.Length with
    | 0 -> ()
    | 1 -> bprintf usage " [option]"
    | _ -> bprintf usage " [option]..."
    if Option.isSome rest then bprintf usage " [arg]..."
    bprintf usage "\n\n"
    let helpOffset =
      (argSpec
      |> Array.map (fun a -> a.Name.Length + (typeName a.Type).Length)
      |> Array.max) 
      + 5
    let helpWidth = (screenWidth - helpOffset - 1)
    for arg in argSpec do
      let argType = typeName arg.Type
      bprintf usage "  %s %s%s" arg.Name argType (String(' ', (helpOffset - arg.Name.Length - argType.Length - 3)))
      let rec loop = function
        | Some msg, i ->
          bprintf usage "%s\n" msg
          match i with
          | None -> ()
          | Some i ->  
            bprintf usage "%s" (String(' ', helpOffset))
            loop (getSnippet i helpWidth arg.Help)
        | None, _ -> ()
      loop (getSnippet 0 helpWidth arg.Help)
    usage.ToString()

  member this.Parse(args) =
    let options = dict [ for arg in argSpec -> arg.Name.ToUpper(), arg ]
    let rec eval = function
      | ("-?" | "/?" | "--help") :: _ ->
        printfn "\n%s" <| this.Usage()
        exit 1
      | (opt : string) :: otherArgs ->
        match options.TryGetValue(opt.ToUpper()) with
        | true, argInfo ->
          let getSecondArg f =
            let fail() = failwithf "%s: %s expected" opt (typeName argInfo.Type)
            match otherArgs with
            | arg :: r -> 
              try f arg, r
              with _ -> fail()
            | [] -> fail()
          let next c f = match getSecondArg c with arg, r -> f arg; r
          let r =
            match argInfo.Type with
            | ArgType.String f -> next id f
            | ArgType.Float f -> next float f
            | ArgType.Int f -> next int f
            | ArgType.Unit f -> f(); otherArgs
            | ArgType.TimeSpan f -> next TimeSpan.Parse f
            | ArgType.DateTime f -> next DateTime.Parse f
          eval r
        | _ ->
          match rest with
          | Some f -> f opt; eval otherArgs
          | None -> failwithf "Unknown option: %s" opt
      | _ -> ()
    eval (List.ofArray args)

  member this.Parse() = this.Parse(Environment.GetCommandLineArgs().[1..])
